perm filename PASTE.OLD[PUB,SYS] blob
sn#215395 filedate 1976-10-12 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00013 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 BEGOF("PASTE")
C00004 00003 PUBLIC SIMPLE PROCEDURE PASTE! $"#
C00005 00004 PUBLIC RECURSIVE PROCEDURE DBREAK $"#
C00007 00005 PUBLIC SIMPLE STRING PROCEDURE ENOUGH(STRING STR INTEGER WID, F) $"#
C00008 00006 PUBLIC INTEGER SIMPLE PROCEDURE LINESLEFT $"#
C00009 00007 PUBLIC RECURSIVE INTEGER PROCEDURE FIND!ROOM(INTEGER SOURCE,
C00013 00008 PUBLIC INTEGER SIMPLE PROCEDURE NEWBLANK(INTEGER MOLE) $"#
C00014 00009 PRIVATE SIMPLE INTEGER PROCEDURE OWLOUT(STRING C1,C2,C3) $"#
C00016 00010 PUBLIC RECURSIVE PROCEDURE PLACELINE(INTEGER CHARS,POSN,XPOSN,FAKE,
C00026 00011 PUBLIC SIMPLE PROCEDURE SNEAKLINE(STRING S) $"#
C00027 00012 PRIVATE SIMPLE INTEGER PROCEDURE TOPMOST(INTEGER COLNO, LINO) $"#
C00028 00013 FINISHED
C00029 ENDMK
C⊗;
BEGOF("PASTE")
COMMENT
*** Variations at Different Sites ***
In PLACELINE, some sites don't need to allocate extra text lines for
superscripts and subscripts in XCRIBL mode.
***
Paste a line, with its leading and somescripts and footnotes,
into a column obeying GROUP constraints.
;
PROCEDURES
PUBLIC SIMPLE PROCEDURE PASTE! ;$"#
BEGIN "PASTE!"
FTGP ← 0 ;
FTGP2 ← 0 ; TES 11/2/74 ;
MILLVERTI ← -MILLVERTIDEFAULT ; TES 11/2/74 SET TO MSPREADM AT 1ST TEXT LINE ;
NEEDMILLVERTI ← FALSE ; TES 11/2/74 ;
BIND(DECLARE(SYMNUM("FOOT"), PORTYPE), IXFOOT ← PUTI(4, -1)) ;
MESGS ← 0 ;
NOPGPH ← TRUE ;
END "PASTE!" ;
PUBLIC RECURSIVE PROCEDURE DBREAK ;$"#
IF ON THEN IF NOPGPH THEN NOPGPH ← -1 ELSE
BEGIN INTEGER STTS ;
NOPGPH ← -1 ;
BOUND(3) ;
IF POSN > INDENT OR VERBATIM OR SNUCK THEN TES 11/17/74 SNUCK;
BEGIN "A PGPH"
SNUCK ← FALSE ; TES 11/17/74 ;
PLACELINE(IF LASTWDBRK=OAKS THEN OAKS-1 ELSE OAKS, POSN MIN MAXIM, XMAXIM-FSHORT,
FAKE, ABOVEX MAX BRKABX,
-(BELOWX MIN BRKBLX),
IF NOFILL THEN LEADNM ELSE IF FIRST THEN LEADFM ELSE SPREADM-1,
IF NOFILL THEN MLEADNM ELSE IF FIRST THEN MLEADFM ELSE MSPREADM,
PLBL, JUSTJUST, 0) ;
FSHORT ← SINCELFM ← 0 ;
IF ENDCASE=2 THEN BEGIN STTS←STARTS; IF ENDBLOCK THEN WARN("=","Missed END in Response|Footnote");
STARTS ← STARTS + STTS ; END ;
END "A PGPH"
ELSE SNUCK ← FALSE ; TES 11/17/74 ;
END "DBREAK" ;
PUBLIC SIMPLE STRING PROCEDURE ENOUGH(STRING STR ; INTEGER WID, F) ;$"#
BEGIN TES 11/29/73 enough of STR to extend WID charws in font F ;
INTEGER WASF, N, X ; STRING S2 ;
WASF ← THISFONT ; S2 ← STR ;
IDASSIGN(FNTFIL[F], CW) ; X ← WID * CHARW ; N ← 0 ;
WHILE FULSTR(S2) AND X GEQ 0 DO
BEGIN N←N+1 ; X ← X-CW[LOP(S2)] END ;
IF X<0 THEN N ← N-1 ;
IDASSIGN(FNTFIL[WASF], CW) ;
RETURN(STR[1 TO N]) ;
END ;
PUBLIC INTEGER SIMPLE PROCEDURE LINESLEFT ;$"#
BEGIN
INTEGER TOT, LEFT ;
TOT ← LEFT ← IF AREAIXM AND 0 LEQ STATUS LEQ 2 THEN LINES ELSE LINECT(IXTEXT) ;
LEFT ← LEFT + XGENLINES; RKJ;
IF STATUS=1 THEN LEFT ← LEFT - (LINE + COVERED + PINE) ;
IF NOT NOPGPH THEN LEFT ← LEFT - ( 1+(ABOVEX MAX BRKABX)-(BELOWX MIN BRKBLX)+
(IF NOFILL THEN LEADNM ELSE IF FIRST THEN LEADFM ELSE SPREADM-1) ) ;
RETURN(IF LEFT<0 THEN -(LEFT+TOT) ELSE LEFT) ;
END "LINESLEFT" ;
PUBLIC RECURSIVE INTEGER PROCEDURE FIND!ROOM(INTEGER SOURCE,
EXTRA, FROMCOL, FROMLINE, MORECOMING) ;$"#
BEGIN "FIND!ROOM"
INTEGER WANT, LEAD, I, C, L, SAVEAREA, KOLS ; LABEL FOUND, TRYHERE ;
STRING FTSTR ; TES 9/12/74 ;
ASSUREAREA ;
IF SOURCE LEQ 0 THEN BEGIN WANT←EXTRA ; LEAD←-SOURCE END ELSE BEGIN WANT←1; LEAD←0 END;
IF WANT > LINES THEN TES 12/6/73 LENGTHENED MESSAGE ;
BEGIN WARN("Can't fit here",
<"This line (with its PREFACE,SPREAD,SOMESCRIPTS) needs " &
CVS(WANT) & " lines of paper,
but AREA " & SYM[LDB(BIXNUM(AREAIXM))] &
" is declared only " & CVS(LINES) & " lines HIGH">);
RETURN(FALSE) ;
END;
KOLS ← IF FROMCOL > COLS THEN 2*COLS ELSE COLS ;
TRYHERE:
FOR C ← FROMCOL THRU KOLS DO
IF (LINES-MORECOMING) - (L← IF C=FROMCOL THEN FROMLINE ELSE 0) + XGENLINES - PINE GEQ
(IF L THEN WANT+LEAD ELSE WANT) THEN GO TO FOUND ;
IF GLINEM AND C NEQ FROMCOL AND MOVEGROUP(TRUE, KOLS+1-COLS,0,EXTRA) THEN
BEGIN C←COL; L←LINE; GO FOUND END ;
IF TEXTAR(AREAIXM) THEN
BEGIN
FTSTR ← SSTK[FOOTSTR(AREAIXM)] ; SSTK[FOOTSTR(AREAIXM)] ← NULL ; TES 9/12/74 ;
NEXTPAGE ; OPENAREA(AREAIXM) ;
SSTK[FOOTSTR(AREAIXM)] ← FTSTR & SSTK[FOOTSTR(AREAIXM)] ; TES 9/12/74 ;
IF FROMCOL>COLS AND COL LEQ COLS OR FROMCOL LEQ COLS AND COL>COLS THEN
BEGIN
TES 12/6/73 DELETED: IF FROMCOL>COLS THEN FOOTTOP ← 1 ; COMMENT ADDED BY RKJ ;
PAL SWAP COL ; LINE SWAP PINE ;
END ;
FROMCOL ← COL ; FROMLINE ← LINE; GO TO TRYHERE ;
END
ELSE BEGIN TES 12/6/73 LENGTHENED MESSAGE ;
WARN("TITLE AREA overflow","Overflowed title area " & SYM[LDB(BIXNUM(AREAIXM))]) ;
FOR C ← 1 THRU COLS DO AA[C, 0] ← AA[COLS+C,0] ← 0 ;
PAL ← (C ← COL ← 1) + COLS ; L ← 0 ;
END ;
FOUND:
IF C=COL THEN LINE←L
ELSE IF GLINEM AND MOVEGROUP(FALSE, C, L, EXTRA) THEN BEGIN L ← LINE ; C ← COL END
ELSE BEGIN
COL ← C ; PAL ← (COL+COLS-1) MOD (2*COLS) + 1 ;
LINE ← L ; PINE ← RH(AA[PAL,0]) ;
END ;
IF OLX+WANT+LEAD > OLXX THEN GROWOWLS(WANT+LEAD+25) ;
IF LINE+WANT+LEAD > ARRINFO(AA,4) THEN GROWAA(LINE+WANT+LEAD+10) ; TES 11/6/74;
IF LINE AND LEAD THEN
BEGIN
FOR I ← 1 THRU LEAD DO AA[COL, LINE+I] ← NEWBLANK(IF GROUPM OR I>1 THEN ABV!BLW ELSE BLW) ;
LINE ← LINE + LEAD ;
END ;
RETURN(L+1) ;
END "FIND!ROOM" ;
PUBLIC INTEGER SIMPLE PROCEDURE NEWBLANK(INTEGER MOLE) ;$"#
BEGIN MOLES[OLX←OLX+1]←MOLE ; OWLS[OLX]←0 ; RETURN(OLX); END "NEWBLANK";
PUBLIC INTEGER SIMPLE PROCEDURE NEWNEWBLANK(INTEGER NMOLE) ;$"#
BEGIN NMOLES[NOLX←NOLX+1]←NMOLE ; NOWLS[NOLX]←0 ; RETURN(NOLX); END "NEWNEWBLANK";
PRIVATE SIMPLE INTEGER PROCEDURE OWLOUT(STRING C1,C2,C3) ;$"#
BEGIN "OWLOUT"
TES 11/2/74 2 ARGUMENTS TO AVOID CONCATENATION ;
IF 0=LENGTH(C1)+LENGTH(C2)+LENGTH(C3) THEN RETURN(0) ;
OWLSEQ ← OWLSEQ + 1 ;
IF INTER LEQ 0 THEN NOPORTION ;
OUT(SINTER, CVS(OWLSEQ)) ; OUT(SINTER, ALTMODE) ;
OUT(SINTER, C1) ; OUT(SINTER, C2) ; OUT(SINTER, C3) ;
RETURN(OWLSEQ) ;
END "OWLOUT" ;
PRIVATE SIMPLE PROCEDURE OWLPLACE(INTEGER OWLOUTVALUE, MILLLEAD) ;$"#
BEGIN "OWLPLACE"
TES 11/2/74 ALLOWS OWLOUT (FORMERLY OWT) TO BE CALLED WITHOUT COPYING OWL ;
OWLS[OLX] ← OWLOUTVALUE ;
IF MILLVERTI<0 THEN MILLVERTI←MSPREADM
ELSE IF MILLVERTI NEQ MILLLEAD THEN
BEGIN
NEEDMILLVERTI ← TRUE ;
RKJ: 6-FEB-75 make the following agree with what actually happens in pass 2 ;
IF MILLLEAD<MILLVERTI
THEN OVEREST ← OVEREST + ((MILLVERTI-MILLLEAD)*VBPI+500) DIV 1000
ELSE OVEREST ← OVEREST - ((MILLLEAD-MILLVERTI)*VBPI+500) DIV 1000 ;
END ;
MLEAD[OLX] ← MILLLEAD-MILLVERTI ; TES 11/2/74 EXTRA LEADING ;
END "OWLPLACE" ;
PUBLIC RECURSIVE PROCEDURE PLACELINE(INTEGER CHARS,POSN,XPOSN,FAKE,
ABOVE,BELOW,LEADB,MLEADB,FIRSTLBL,
JUSTIFY,MORECOMING) ;$"#
BEGIN "PLACELINE"
INTEGER FOOTFLAG, NEEDS, TOPLINE, GR, ATOP, I, TOLBL, LBL, FOOTNUM, WASFRAME, WASCOL, WASOLX ;
COMMENT FOOTFLAG CHANGES RKJ 10-10-73;
STRING XREF;
INTEGER SOWL, MSKIP, MGSKIP, MCHARH ; TES 11/2&7/74 ;
IF NOT DEBUG THEN XREF ← ALTMODE
ELSE BEGIN
XREF ← ERRLINE&"/"&SRCPAGE&"["&MACLINE&"]" ;
FOR I ← 1 THRU MESGS DO XREF ← XREF & RUBOUT & MESGSARR[I] ;
MESGS←0 ; XREF ← XREF & ALTMODE ;
END ;
IFC SAILVER THENC
COMMENT RHT 5/7/76 ;
IF XCRIBL THEN
BEGIN
IF CSCRIPTM THEN
BEGIN
OVEREST←OVEREST-SCRIPTSTRENGTH*(ABOVE+BELOW);
IF DSCRIPTM THEN
OVEREST←OVEREST-SCRIPTSTRENGTH*(ABOVE+BELOW);
END;
ABOVE←BELOW←0;
END;
ENDC
IFC PARCVER OR ITSVER OR CMUVER
THENC IF XCRIBL THEN ABOVE←BELOW←0; comment scripts; ENDC
SOWL ← OWLOUT(XREF,OWL[1 TO CHARS], CRLF) ; TES 11/2/74 AVOID CAT ;
ASSUREAREA ;
MGSKIP ← MILLGSKIP(AREAIXM) ; MILLGSKIP(AREAIXM) ← 0 ; TES 11/7/74 ;
MSKIP ← MILLSKIP(AREAIXM) ; MILLSKIP(AREAIXM) ← 0 ; TES 11/7/74 ;
IF COL > COLS THEN
BEGIN "INFOOT" TES 12/6/73 SEPARATED CASES ;
IF FOOTNUM ← FOOTTOP THEN
BEGIN comment First Footnote belonging to a line ;
GR ← GROUPM ; TES 1/15/74 ADDED 'OR GLINEM=0' BELOW: ;
TES 8/22/74 PAL BELOW WAS COL! ;
IF GROUPM=0 OR GLINEM=0 THEN GLINEM ← AA[PAL,PINE] ;
GROUPM ← 1 ; FOOTTOP ← 0 ;
END ;
IF ATOP ← LINE=0 THEN ABOVE ← ABOVE + 1 + (FTGP+FTGP2) ; comment assure room for FOOTSEP ;
END "INFOOT" ;
FOOTFLAG ← COL LEQ COLS AND FULSTR(SSTK[FOOTSTR(AREAIXM)]);
IF FOOTFLAG THEN
MORECOMING←MORECOMING+2; RKJ 11/20/73 ;
TES ADDED 11/7/74 : ;
MLEADB ← MLEADB + MSKIP ;
MCHARH ← IF XCRIBL THEN ABS(MILLVERTI) + (CHARH*1000 + VBPI DIV 2) DIV VBPI ELSE 166 ;
LEADB ← LEADB + MLEADB DIV MCHARH ; MLEADB ← MLEADB MOD MCHARH ;
ABOVE ← ABOVE + MGSKIP DIV MCHARH ;
MGSKIP ← MGSKIP MOD MCHARH ;
WHILE NOT (TOPLINE ← FIND!ROOM(-LEADB,NEEDS←ABOVE+BELOW+1,COL,LINE,MORECOMING)) DO
BEGIN ABOVE←(ABOVE-1)MAX 0; BELOW←(BELOW-1)MAX 0 END;
IF XCRIBL AND (COL = 1 OR COL = COLS+1) THEN TES 11/19/73 COL 1 ONLY! ;
BEGIN "KLUDGE"
OWN INTEGER STD;
OVEREST←OVEREST+NEEDS*((STD←STDCHARH)-CHARH);
RKJ: 6-Feb-75 made code below more nearly correct ;
IF OVEREST NEQ 0 THEN
BEGIN "MUST FIXUP"
STD←STD + (MILLVERTI*VBPI+500) DIV 1000;
IF OVEREST>0
THEN BEGIN XGENLINES←XGENLINES+OVEREST DIV STD; OVEREST←OVEREST MOD STD END
ELSE WHILE OVEREST<0 DO BEGIN XGENLINES←XGENLINES-1; OVEREST←OVEREST+STD; END;
END "MUST FIXUP";
END "KLUDGE";
WASOLX ← OLX - (LINE + 1 - TOPLINE) ;
IF COL > COLS THEN
BEGIN "BEGFOOT" TES 12/6/73 SEPARATED CASES ;
IF FOOTNUM THEN COMMENT FIRST FOOTNOTE BELONGING TO A LINE ;
BEGIN "FOOT1"
GROUPM ← GR ; IF GROUPM=0 THEN GLINEM ← 0 ;
END "FOOT1" ;
IF ATOP THEN BEGIN ABOVE ← ABOVE - 1 - (FTGP+FTGP2) ; TES 11/29/73 ;
NEEDS ← NEEDS - 1 - (FTGP+FTGP2) END ;
IF LINE = 0 THEN
BEGIN "PUTFOOTSEPS"
TES 11/29/73 ADDED FTGP AND ENOUGH ;
TES 11/2&7/74 ADDED FTGP2 AND MILLVERTIDEFAULT ;
MLEADB ← MILLVERTIDEFAULT ; TES 11/7/74 ;
FOR I ← 1 THRU FTGP DO AA[COL,I] ←
NEWBLANK(IF I=1 THEN ABV ELSE ABV!BLW) ;
AA[COL, LINE←TOPLINE←1+FTGP] ← OLX ← OLX + 1 ;
IF XCRIBL THEN
OWLPLACE(OWLOUT(XREF,PICKFONT(FSFONT),
ENOUGH(FOOTSEP,COLWID(AREAIXM),FSFONT)&CRLF),
MILLVERTIDEFAULT)
ELSE
OWLPLACE(OWLOUT(XREF,
FOOTSEP[1 TO COLWID(AREAIXM)],
CRLF),
MILLVERTIDEFAULT) ;
MOLES[OLX] ← IF FTGP=0 THEN BLW ELSE ABV!BLW ;
FOR I ← LINE+1 THRU LINE+FTGP2 DO AA[COL,I] ← NEWBLANK(ABV!BLW);
LINE ← LINE + FTGP2 ; TES 11/6/74 ;
END "PUTFOOTSEPS" ;
END "BEGFOOT" ;
FOR I ← 1 THRU ABOVE DO AA[COL,LINE+I] ←
NEWBLANK(IF GROUPM OR TOPLINE<LINE+I THEN ABV!BLW ELSE BLW) ;
AA[COL, LINE+ABOVE+1] ← OLX ← OLX + 1 ;
IF LINE = 0 THEN MLEADB ← MILLVERTIDEFAULT ; TES 11/7/74 ;
OWLPLACE(SOWL, MGSKIP+MLEADB) ; TES 11/2&7/74 ;
MOLES[OLX] ← (IF GROUPM OR TOPLINE<LINE+ABOVE+1 THEN ABV ELSE 0) LOR (IF GROUPM OR BELOW THEN BLW ELSE 0);
IF XCRIBL THEN I←MAXIM*CHARW + FAKE - XPOSN ELSE I←MAXIM - (POSN-FAKE);
IF JUSTIFY AND I > 0 THEN SHORT[OLX]←I ;
IF FIRSTLBL NEQ -TWO(13) THEN
BEGIN "PAGE LABELS"
LBL ← PLBL ; TOLBL ← 0 ;
WHILE LBL NEQ FIRSTLBL AND LBL NEQ -TWO(13) DO
LBL ← IF (TOLBL←LBL)>0 THEN ITBL[TOLBL] ELSE NUMBER[-TOLBL] ;
IF LBL=-TWO(13) THEN WARN("=","Page label not in Page Label L.L.!!!")
ELSE IF TOLBL=0 THEN PLBL ← -TWO(13)
ELSE IF TOLBL > 0 THEN ITBL[TOLBL] ← -TWO(13)
ELSE NUMBER[-TOLBL] ← -TWO(13) ;
BRKPLBL ← PLBL ;
DPB(IF FIRSTLBL<0 THEN PUTI(1,FIRSTLBL) ELSE FIRSTLBL, LABELM(OLX)) ;
END "PAGE LABELS" ;
FOR I ← ABOVE+2 THRU NEEDS DO AA[COL,LINE+I] ← NEWBLANK(IF GROUPM OR I<NEEDS THEN ABV!BLW ELSE BLW) ;
IF GROUPM AND NOT GLINEM THEN
DPB(0,ABOVEM(GLINEM←IF COL>COLS THEN TOPMOST(PAL,PINE) ELSE AA[COL,TOPLINE])) ;
TES 12/6/73 ADDED TOPMOST(PAL,PINE) ;
LINE ← LINE + NEEDS ;
IF FOOTFLAG THEN comment, Footnotes ;
BEGIN "FOOTNOTES"
WHILE (FOOTNUM←IF PINE=0 THEN 1 ELSE LDB(FOOTM(AA[PAL,PINE])) + 1) = 31 DO
BEGIN
WARN("=",">30 lines in col. "&COL&" want footnotes.") ;
FIND!ROOM(LINE, 1, COL+1, 0, 0) ;
END ;
IF FOOTNUM=32 THEN FOOTNUM ← 1 ; DPB(FOOTNUM, FOOTM(OLX)) ;
SEND(IXFOOT, CRLF&TB&TB& "END ""!FOOTNOTES"";;") ;
AA[COL,0] ← LHRH(COVERED, LINE) ; PINE SWAP LINE ; PAL SWAP COL ;
WASCOL ← COL ; WASFRAME ← FRAMEIDA ; BEGINBLOCK(TRUE, 3, "!FOOTNOTES") ; BREAKM ← 0 ;
FOOTTOP ← -1 ; WASOLX ← OLX ; RECEIVE(IXFOOT, NULL) ; PASS ; TOEND ; FOOTTOP ← 0 ;
AA[COL,0] ← LHRH(COVERED, LINE) ;
IF WASCOL NEQ COL OR WASFRAME NEQ FRAMEIDA THEN
BEGIN FOOTNUM ← 31 ; IF WASFRAME=FRAMEIDA THEN DPB(31, FOOTM(WASOLX)) END ;
DPB(FOOTNUM, FOOTM(AA[COL,LINE])) ; PAL SWAP COL ; PINE SWAP LINE ;
END "FOOTNOTES" ;
END "PLACELINE" ;
PUBLIC SIMPLE PROCEDURE SNEAKLINE(STRING S) ;$"#
RKJ: added following procedure for change to SNEAK 6-Feb-75 ;
BEGIN "SNEAKLINE"
ASSUREAREA;
XGENLINES ← XGENLINES + 1;
FIND!ROOM(1, 0, COL, LINE, 0) ;
AA[COL,LINE+1] ← OLX ← OLX + 1 ;
OWLPLACE(OWLOUT(ALTMODE, S, CRLF), ABS(MILLVERTI)) ;
LINE ← LINE + 1 ;
END "SNEAKLINE";
PRIVATE SIMPLE INTEGER PROCEDURE TOPMOST(INTEGER COLNO, LINO) ;$"#
BEGIN TES 12/6/73 USED BY PLACELINE FOR GLINEM IN FOOT ;
WHILE LINO>1 AND (LDB(ABOVEM(AA[COLNO,LINO])) OR LDB(BELOWM(AA[COL,LINO-1]))) DO
LINO ← LINO - 1 ;
RETURN(AA[COLNO,LINO]) ;
END "TOPMOST" ;
FINISHED
ENDOF("PASTE")